home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl-5.003.tar.gz / perl-5.003.tar / perl-5.003 / pp_hot.c < prev    next >
C/C++ Source or Header  |  1996-03-25  |  42KB  |  1,969 lines
  1. /*    pp_hot.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
  12.  * shaking the air.
  13.  *
  14.  *            Awake!  Awake!  Fear, Fire, Foes!  Awake!
  15.  *                     Fire, Foes!  Awake!
  16.  */
  17.  
  18. #include "EXTERN.h"
  19. #include "perl.h"
  20.  
  21. /* Hot code. */
  22.  
  23. PP(pp_const)
  24. {
  25.     dSP;
  26.     XPUSHs(cSVOP->op_sv);
  27.     RETURN;
  28. }
  29.  
  30. PP(pp_nextstate)
  31. {
  32.     curcop = (COP*)op;
  33.     TAINT_NOT;        /* Each statement is presumed innocent */
  34.     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
  35.     FREETMPS;
  36.     return NORMAL;
  37. }
  38.  
  39. PP(pp_gvsv)
  40. {
  41.     dSP;
  42.     EXTEND(sp,1);
  43.     if (op->op_private & OPpLVAL_INTRO)
  44.     PUSHs(save_scalar(cGVOP->op_gv));
  45.     else
  46.     PUSHs(GvSV(cGVOP->op_gv));
  47.     RETURN;
  48. }
  49.  
  50. PP(pp_null)
  51. {
  52.     return NORMAL;
  53. }
  54.  
  55. PP(pp_pushmark)
  56. {
  57.     PUSHMARK(stack_sp);
  58.     return NORMAL;
  59. }
  60.  
  61. PP(pp_stringify)
  62. {
  63.     dSP; dTARGET;
  64.     STRLEN len;
  65.     char *s;
  66.     s = SvPV(TOPs,len);
  67.     sv_setpvn(TARG,s,len);
  68.     SETTARG;
  69.     RETURN;
  70. }
  71.  
  72. PP(pp_gv)
  73. {
  74.     dSP;
  75.     XPUSHs((SV*)cGVOP->op_gv);
  76.     RETURN;
  77. }
  78.  
  79. PP(pp_gelem)
  80. {
  81.     GV *gv;
  82.     SV *sv;
  83.     SV *ref;
  84.     char *elem;
  85.     dSP;
  86.  
  87.     sv = POPs;
  88.     elem = SvPV(sv, na);
  89.     gv = (GV*)POPs;
  90.     ref = Nullsv;
  91.     sv = Nullsv;
  92.     switch (elem ? *elem : '\0')
  93.     {
  94.     case 'A':
  95.     if (strEQ(elem, "ARRAY"))
  96.         ref = (SV*)GvAV(gv);
  97.     break;
  98.     case 'C':
  99.     if (strEQ(elem, "CODE"))
  100.         ref = (SV*)GvCV(gv);
  101.     break;
  102.     case 'F':
  103.     if (strEQ(elem, "FILEHANDLE"))
  104.         ref = (SV*)GvIOp(gv);
  105.     break;
  106.     case 'G':
  107.     if (strEQ(elem, "GLOB"))
  108.         ref = (SV*)gv;
  109.     break;
  110.     case 'H':
  111.     if (strEQ(elem, "HASH"))
  112.         ref = (SV*)GvHV(gv);
  113.     break;
  114.     case 'N':
  115.     if (strEQ(elem, "NAME"))
  116.         sv = newSVpv(GvNAME(gv), GvNAMELEN(gv));
  117.     break;
  118.     case 'P':
  119.     if (strEQ(elem, "PACKAGE"))
  120.         sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
  121.     break;
  122.     case 'S':
  123.     if (strEQ(elem, "SCALAR"))
  124.         ref = GvSV(gv);
  125.     break;
  126.     }
  127.     if (ref)
  128.     sv = newRV(ref);
  129.     if (sv)
  130.     sv_2mortal(sv);
  131.     else
  132.     sv = &sv_undef;
  133.     XPUSHs(sv);
  134.     RETURN;
  135. }
  136.  
  137. PP(pp_and)
  138. {
  139.     dSP;
  140.     if (!SvTRUE(TOPs))
  141.     RETURN;
  142.     else {
  143.     --SP;
  144.     RETURNOP(cLOGOP->op_other);
  145.     }
  146. }
  147.  
  148. PP(pp_sassign)
  149. {
  150.     dSP; dPOPTOPssrl;
  151.     MAGIC *mg;
  152.  
  153.     if (op->op_private & OPpASSIGN_BACKWARDS) {
  154.     SV *temp;
  155.     temp = left; left = right; right = temp;
  156.     }
  157.     if (tainting && tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) ||
  158.                 !((mg = mg_find(left, 't')) && mg->mg_len & 1)))
  159.     {
  160.     TAINT_NOT;
  161.     }
  162.     SvSetSV(right, left);
  163.     SvSETMAGIC(right);
  164.     SETs(right);
  165.     RETURN;
  166. }
  167.  
  168. PP(pp_cond_expr)
  169. {
  170.     dSP;
  171.     if (SvTRUEx(POPs))
  172.     RETURNOP(cCONDOP->op_true);
  173.     else
  174.     RETURNOP(cCONDOP->op_false);
  175. }
  176.  
  177. PP(pp_unstack)
  178. {
  179.     I32 oldsave;
  180.     TAINT_NOT;        /* Each statement is presumed innocent */
  181.     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
  182.     FREETMPS;
  183.     oldsave = scopestack[scopestack_ix - 1];
  184.     LEAVE_SCOPE(oldsave);
  185.     return NORMAL;
  186. }
  187.  
  188. PP(pp_seq)
  189. {
  190.     dSP; tryAMAGICbinSET(seq,0); 
  191.     {
  192.       dPOPTOPssrl;
  193.       SETs( sv_eq(left, right) ? &sv_yes : &sv_no );
  194.       RETURN;
  195.     }
  196. }
  197.  
  198. PP(pp_concat)
  199. {
  200.   dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
  201.   {
  202.     dPOPTOPssrl;
  203.     STRLEN len;
  204.     char *s;
  205.     if (TARG != left) {
  206.     s = SvPV(left,len);
  207.     sv_setpvn(TARG,s,len);
  208.     }
  209.     else if (SvGMAGICAL(TARG))
  210.     mg_get(TARG);
  211.     else if (!SvOK(TARG)) {
  212.     s = SvPV_force(TARG, len);
  213.     sv_setpv(TARG, "");    /* Suppress warning. */
  214.     }
  215.     s = SvPV(right,len);
  216.     sv_catpvn(TARG,s,len);
  217.     SETTARG;
  218.     RETURN;
  219.   }
  220. }
  221.  
  222. PP(pp_padsv)
  223. {
  224.     dSP; dTARGET;
  225.     XPUSHs(TARG);
  226.     if (op->op_flags & OPf_MOD) {
  227.     if (op->op_private & OPpLVAL_INTRO)
  228.         SAVECLEARSV(curpad[op->op_targ]);
  229.         else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
  230.         provide_ref(op, curpad[op->op_targ]);
  231.     }
  232.     RETURN;
  233. }
  234.  
  235. PP(pp_readline)
  236. {
  237.     last_in_gv = (GV*)(*stack_sp--);
  238.     return do_readline();
  239. }
  240.  
  241. PP(pp_eq)
  242. {
  243.     dSP; tryAMAGICbinSET(eq,0); 
  244.     {
  245.       dPOPnv;
  246.       SETs((TOPn == value) ? &sv_yes : &sv_no);
  247.       RETURN;
  248.     }
  249. }
  250.  
  251. PP(pp_preinc)
  252. {
  253.     dSP;
  254.     if (SvIOK(TOPs)) {
  255.     ++SvIVX(TOPs);
  256.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  257.     }
  258.     else
  259.     sv_inc(TOPs);
  260.     SvSETMAGIC(TOPs);
  261.     return NORMAL;
  262. }
  263.  
  264. PP(pp_or)
  265. {
  266.     dSP;
  267.     if (SvTRUE(TOPs))
  268.     RETURN;
  269.     else {
  270.     --SP;
  271.     RETURNOP(cLOGOP->op_other);
  272.     }
  273. }
  274.  
  275. PP(pp_add)
  276. {
  277.     dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
  278.     {
  279.       dPOPTOPnnrl;
  280.       SETn( left + right );
  281.       RETURN;
  282.     }
  283. }
  284.  
  285. PP(pp_aelemfast)
  286. {
  287.     dSP;
  288.     AV *av = GvAV((GV*)cSVOP->op_sv);
  289.     SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
  290.     PUSHs(svp ? *svp : &sv_undef);
  291.     RETURN;
  292. }
  293.  
  294. PP(pp_join)
  295. {
  296.     dSP; dMARK; dTARGET;
  297.     MARK++;
  298.     do_join(TARG, *MARK, MARK, SP);
  299.     SP = MARK;
  300.     SETs(TARG);
  301.     RETURN;
  302. }
  303.  
  304. PP(pp_pushre)
  305. {
  306.     dSP;
  307.     XPUSHs((SV*)op);
  308.     RETURN;
  309. }
  310.  
  311. /* Oversized hot code. */
  312.  
  313. PP(pp_print)
  314. {
  315.     dSP; dMARK; dORIGMARK;
  316.     GV *gv;
  317.     IO *io;
  318.     register FILE *fp;
  319.  
  320.     if (op->op_flags & OPf_STACKED)
  321.     gv = (GV*)*++MARK;
  322.     else
  323.     gv = defoutgv;
  324.     if (!(io = GvIO(gv))) {
  325.     if (dowarn) {
  326.         SV* sv = sv_newmortal();
  327.             gv_fullname(sv,gv);
  328.             warn("Filehandle %s never opened", SvPV(sv,na));
  329.         }
  330.  
  331.     SETERRNO(EBADF,RMS$_IFI);
  332.     goto just_say_no;
  333.     }
  334.     else if (!(fp = IoOFP(io))) {
  335.     if (dowarn)  {
  336.         SV* sv = sv_newmortal();
  337.             gv_fullname(sv,gv);
  338.         if (IoIFP(io))
  339.         warn("Filehandle %s opened only for input", SvPV(sv,na));
  340.         else
  341.         warn("print on closed filehandle %s", SvPV(sv,na));
  342.     }
  343.     SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
  344.     goto just_say_no;
  345.     }
  346.     else {
  347.     MARK++;
  348.     if (ofslen) {
  349.         while (MARK <= SP) {
  350.         if (!do_print(*MARK, fp))
  351.             break;
  352.         MARK++;
  353.         if (MARK <= SP) {
  354.             if (fwrite1(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
  355.             MARK--;
  356.             break;
  357.             }
  358.         }
  359.         }
  360.     }
  361.     else {
  362.         while (MARK <= SP) {
  363.         if (!do_print(*MARK, fp))
  364.             break;
  365.         MARK++;
  366.         }
  367.     }
  368.     if (MARK <= SP)
  369.         goto just_say_no;
  370.     else {
  371.         if (orslen)
  372.         if (fwrite1(ors, 1, orslen, fp) == 0 || ferror(fp))
  373.             goto just_say_no;
  374.  
  375.         if (IoFLAGS(io) & IOf_FLUSH)
  376.         if (Fflush(fp) == EOF)
  377.             goto just_say_no;
  378.     }
  379.     }
  380.     SP = ORIGMARK;
  381.     PUSHs(&sv_yes);
  382.     RETURN;
  383.  
  384.   just_say_no:
  385.     SP = ORIGMARK;
  386.     PUSHs(&sv_undef);
  387.     RETURN;
  388. }
  389.  
  390. PP(pp_rv2av)
  391. {
  392.     dSP; dPOPss;
  393.  
  394.     AV *av;
  395.  
  396.     if (SvROK(sv)) {
  397.       wasref:
  398.     av = (AV*)SvRV(sv);
  399.     if (SvTYPE(av) != SVt_PVAV)
  400.         DIE("Not an ARRAY reference");
  401.     if (op->op_private & OPpLVAL_INTRO)
  402.         av = (AV*)save_svref((SV**)sv);
  403.     if (op->op_flags & OPf_REF) {
  404.         PUSHs((SV*)av);
  405.         RETURN;
  406.     }
  407.     }
  408.     else {
  409.     if (SvTYPE(sv) == SVt_PVAV) {
  410.         av = (AV*)sv;
  411.         if (op->op_flags & OPf_REF) {
  412.         PUSHs((SV*)av);
  413.         RETURN;
  414.         }
  415.     }
  416.     else {
  417.         if (SvTYPE(sv) != SVt_PVGV) {
  418.         char *sym;
  419.  
  420.         if (SvGMAGICAL(sv)) {
  421.             mg_get(sv);
  422.             if (SvROK(sv))
  423.             goto wasref;
  424.         }
  425.         if (!SvOK(sv)) {
  426.             if (op->op_flags & OPf_REF ||
  427.               op->op_private & HINT_STRICT_REFS)
  428.             DIE(no_usym, "an ARRAY");
  429.             if (GIMME == G_ARRAY)
  430.             RETURN;
  431.             RETPUSHUNDEF;
  432.         }
  433.         sym = SvPV(sv,na);
  434.         if (op->op_private & HINT_STRICT_REFS)
  435.             DIE(no_symref, sym, "an ARRAY");
  436.         sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
  437.         }
  438.         av = GvAVn(sv);
  439.         if (op->op_private & OPpLVAL_INTRO)
  440.         av = save_ary(sv);
  441.         if (op->op_flags & OPf_REF) {
  442.         PUSHs((SV*)av);
  443.         RETURN;
  444.         }
  445.     }
  446.     }
  447.  
  448.     if (GIMME == G_ARRAY) {
  449.     I32 maxarg = AvFILL(av) + 1;
  450.     EXTEND(SP, maxarg);
  451.     Copy(AvARRAY(av), SP+1, maxarg, SV*);
  452.     SP += maxarg;
  453.     }
  454.     else {
  455.     dTARGET;
  456.     I32 maxarg = AvFILL(av) + 1;
  457.     PUSHi(maxarg);
  458.     }
  459.     RETURN;
  460. }
  461.  
  462. PP(pp_rv2hv)
  463. {
  464.  
  465.     dSP; dTOPss;
  466.  
  467.     HV *hv;
  468.  
  469.     if (SvROK(sv)) {
  470.       wasref:
  471.     hv = (HV*)SvRV(sv);
  472.     if (SvTYPE(hv) != SVt_PVHV)
  473.         DIE("Not a HASH reference");
  474.     if (op->op_private & OPpLVAL_INTRO)
  475.         hv = (HV*)save_svref((SV**)sv);
  476.     if (op->op_flags & OPf_REF) {
  477.         SETs((SV*)hv);
  478.         RETURN;
  479.     }
  480.     }
  481.     else {
  482.     if (SvTYPE(sv) == SVt_PVHV) {
  483.         hv = (HV*)sv;
  484.         if (op->op_flags & OPf_REF) {
  485.         SETs((SV*)hv);
  486.         RETURN;
  487.         }
  488.     }
  489.     else {
  490.         if (SvTYPE(sv) != SVt_PVGV) {
  491.         char *sym;
  492.  
  493.         if (SvGMAGICAL(sv)) {
  494.             mg_get(sv);
  495.             if (SvROK(sv))
  496.             goto wasref;
  497.         }
  498.         if (!SvOK(sv)) {
  499.             if (op->op_flags & OPf_REF ||
  500.               op->op_private & HINT_STRICT_REFS)
  501.             DIE(no_usym, "a HASH");
  502.             if (GIMME == G_ARRAY) {
  503.             SP--;
  504.             RETURN;
  505.             }
  506.             RETSETUNDEF;
  507.         }
  508.         sym = SvPV(sv,na);
  509.         if (op->op_private & HINT_STRICT_REFS)
  510.             DIE(no_symref, sym, "a HASH");
  511.         sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
  512.         }
  513.         hv = GvHVn(sv);
  514.         if (op->op_private & OPpLVAL_INTRO)
  515.         hv = save_hash(sv);
  516.         if (op->op_flags & OPf_REF) {
  517.         SETs((SV*)hv);
  518.         RETURN;
  519.         }
  520.     }
  521.     }
  522.  
  523.     if (GIMME == G_ARRAY) { /* array wanted */
  524.     *stack_sp = (SV*)hv;
  525.     return do_kv(ARGS);
  526.     }
  527.     else {
  528.     dTARGET;
  529.     if (HvFILL(hv)) {
  530.         sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
  531.         sv_setpv(TARG, buf);
  532.     }
  533.     else
  534.         sv_setiv(TARG, 0);
  535.     SETTARG;
  536.     RETURN;
  537.     }
  538. }
  539.  
  540. PP(pp_aassign)
  541. {
  542.     dSP;
  543.     SV **lastlelem = stack_sp;
  544.     SV **lastrelem = stack_base + POPMARK;
  545.     SV **firstrelem = stack_base + POPMARK + 1;
  546.     SV **firstlelem = lastrelem + 1;
  547.  
  548.     register SV **relem;
  549.     register SV **lelem;
  550.  
  551.     register SV *sv;
  552.     register AV *ary;
  553.  
  554.     HV *hash;
  555.     I32 i;
  556.     int magic;
  557.  
  558.     delaymagic = DM_DELAY;        /* catch simultaneous items */
  559.  
  560.     /* If there's a common identifier on both sides we have to take
  561.      * special care that assigning the identifier on the left doesn't
  562.      * clobber a value on the right that's used later in the list.
  563.      */
  564.     if (op->op_private & OPpASSIGN_COMMON) {
  565.         for (relem = firstrelem; relem <= lastrelem; relem++) {
  566.             /*SUPPRESS 560*/
  567.             if (sv = *relem)
  568.                 *relem = sv_mortalcopy(sv);
  569.         }
  570.     }
  571.  
  572.     relem = firstrelem;
  573.     lelem = firstlelem;
  574.     ary = Null(AV*);
  575.     hash = Null(HV*);
  576.     while (lelem <= lastlelem) {
  577.     tainted = 0;        /* Each item stands on its own, taintwise. */
  578.     sv = *lelem++;
  579.     switch (SvTYPE(sv)) {
  580.     case SVt_PVAV:
  581.         ary = (AV*)sv;
  582.         magic = SvMAGICAL(ary) != 0;
  583.         
  584.         av_clear(ary);
  585.         i = 0;
  586.         while (relem <= lastrelem) {    /* gobble up all the rest */
  587.         sv = NEWSV(28,0);
  588.         assert(*relem);
  589.         sv_setsv(sv,*relem);
  590.         *(relem++) = sv;
  591.         (void)av_store(ary,i++,sv);
  592.         if (magic)
  593.             mg_set(sv);
  594.         tainted = 0;
  595.         }
  596.         break;
  597.     case SVt_PVHV: {
  598.         char *tmps;
  599.         SV *tmpstr;
  600.  
  601.         hash = (HV*)sv;
  602.         magic = SvMAGICAL(hash) != 0;
  603.         hv_clear(hash);
  604.  
  605.         while (relem < lastrelem) {    /* gobble up all the rest */
  606.             STRLEN len;
  607.             if (*relem)
  608.             sv = *(relem++);
  609.             else
  610.             sv = &sv_no, relem++;
  611.             tmps = SvPV(sv, len);
  612.             tmpstr = NEWSV(29,0);
  613.             if (*relem)
  614.             sv_setsv(tmpstr,*relem);    /* value */
  615.             *(relem++) = tmpstr;
  616.             (void)hv_store(hash,tmps,len,tmpstr,0);
  617.             if (magic)
  618.             mg_set(tmpstr);
  619.             tainted = 0;
  620.         }
  621.         }
  622.         break;
  623.     default:
  624.         if (SvTHINKFIRST(sv)) {
  625.         if (SvREADONLY(sv) && curcop != &compiling) {
  626.             if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
  627.             DIE(no_modify);
  628.             if (relem <= lastrelem)
  629.             relem++;
  630.             break;
  631.         }
  632.         if (SvROK(sv))
  633.             sv_unref(sv);
  634.         }
  635.         if (relem <= lastrelem) {
  636.         sv_setsv(sv, *relem);
  637.         *(relem++) = sv;
  638.         }
  639.         else
  640.         sv_setsv(sv, &sv_undef);
  641.         SvSETMAGIC(sv);
  642.         break;
  643.     }
  644.     }
  645.     if (delaymagic & ~DM_DELAY) {
  646.     if (delaymagic & DM_UID) {
  647. #ifdef HAS_SETRESUID
  648.         (void)setresuid(uid,euid,(Uid_t)-1);
  649. #else
  650. #  ifdef HAS_SETREUID
  651.         (void)setreuid(uid,euid);
  652. #  else
  653. #    ifdef HAS_SETRUID
  654.         if ((delaymagic & DM_UID) == DM_RUID) {
  655.         (void)setruid(uid);
  656.         delaymagic &= ~DM_RUID;
  657.         }
  658. #    endif /* HAS_SETRUID */
  659. #    ifdef HAS_SETEUID
  660.         if ((delaymagic & DM_UID) == DM_EUID) {
  661.         (void)seteuid(uid);
  662.         delaymagic &= ~DM_EUID;
  663.         }
  664. #    endif /* HAS_SETEUID */
  665.         if (delaymagic & DM_UID) {
  666.         if (uid != euid)
  667.             DIE("No setreuid available");
  668.         (void)setuid(uid);
  669.         }
  670. #  endif /* HAS_SETREUID */
  671. #endif /* HAS_SETRESUID */
  672.         uid = (int)getuid();
  673.         euid = (int)geteuid();
  674.     }
  675.     if (delaymagic & DM_GID) {
  676. #ifdef HAS_SETRESGID
  677.         (void)setresgid(gid,egid,(Gid_t)-1);
  678. #else
  679. #  ifdef HAS_SETREGID
  680.         (void)setregid(gid,egid);
  681. #  else
  682. #    ifdef HAS_SETRGID
  683.         if ((delaymagic & DM_GID) == DM_RGID) {
  684.         (void)setrgid(gid);
  685.         delaymagic &= ~DM_RGID;
  686.         }
  687. #    endif /* HAS_SETRGID */
  688. #    ifdef HAS_SETEGID
  689.         if ((delaymagic & DM_GID) == DM_EGID) {
  690.         (void)setegid(gid);
  691.         delaymagic &= ~DM_EGID;
  692.         }
  693. #    endif /* HAS_SETEGID */
  694.         if (delaymagic & DM_GID) {
  695.         if (gid != egid)
  696.             DIE("No setregid available");
  697.         (void)setgid(gid);
  698.         }
  699. #  endif /* HAS_SETREGID */
  700. #endif /* HAS_SETRESGID */
  701.         gid = (int)getgid();
  702.         egid = (int)getegid();
  703.     }
  704.     tainting |= (uid && (euid != uid || egid != gid));
  705.     }
  706.     delaymagic = 0;
  707.     if (GIMME == G_ARRAY) {
  708.     if (ary || hash)
  709.         SP = lastrelem;
  710.     else
  711.         SP = firstrelem + (lastlelem - firstlelem);
  712.     RETURN;
  713.     }
  714.     else {
  715.     dTARGET;
  716.     SP = firstrelem;
  717.         
  718.     SETi(lastrelem - firstrelem + 1);
  719.     RETURN;
  720.     }
  721. }
  722.  
  723. PP(pp_match)
  724. {
  725.     dSP; dTARG;
  726.     register PMOP *pm = cPMOP;
  727.     register char *t;
  728.     register char *s;
  729.     char *strend;
  730.     I32 global;
  731.     I32 safebase;
  732.     char *truebase;
  733.     register REGEXP *rx = pm->op_pmregexp;
  734.     I32 gimme = GIMME;
  735.     STRLEN len;
  736.     I32 minmatch = 0;
  737.     I32 oldsave = savestack_ix;
  738.  
  739.     if (op->op_flags & OPf_STACKED)
  740.     TARG = POPs;
  741.     else {
  742.     TARG = GvSV(defgv);
  743.     EXTEND(SP,1);
  744.     }
  745.     s = SvPV(TARG, len);
  746.     strend = s + len;
  747.     if (!s)
  748.     DIE("panic: do_match");
  749.  
  750.     if (pm->op_pmflags & PMf_USED) {
  751.     if (gimme == G_ARRAY)
  752.         RETURN;
  753.     RETPUSHNO;
  754.     }
  755.  
  756.     if (!rx->prelen && curpm) {
  757.     pm = curpm;
  758.     rx = pm->op_pmregexp;
  759.     }
  760.     truebase = t = s;
  761.     if (global = pm->op_pmflags & PMf_GLOBAL) {
  762.     rx->startp[0] = 0;
  763.     if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
  764.         MAGIC* mg = mg_find(TARG, 'g');
  765.         if (mg && mg->mg_len >= 0) {
  766.         rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
  767.         minmatch = (mg->mg_flags & MGf_MINMATCH);
  768.         }
  769.     }
  770.     }
  771.     if (!rx->nparens && !global)
  772.     gimme = G_SCALAR;            /* accidental array context? */
  773.     safebase = (gimme == G_ARRAY) || global;
  774.     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  775.     SAVEINT(multiline);
  776.     multiline = pm->op_pmflags & PMf_MULTILINE;
  777.     }
  778.  
  779. play_it_again:
  780.     if (global && rx->startp[0]) {
  781.     t = s = rx->endp[0];
  782.     if (s > strend)
  783.         goto nope;
  784.     minmatch = (s == rx->startp[0]);
  785.     }
  786.     if (pm->op_pmshort) {
  787.     if (pm->op_pmflags & PMf_SCANFIRST) {
  788.         if (SvSCREAM(TARG)) {
  789.         if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
  790.             goto nope;
  791.         else if (!(s = screaminstr(TARG, pm->op_pmshort)))
  792.             goto nope;
  793.         else if (pm->op_pmflags & PMf_ALL)
  794.             goto yup;
  795.         }
  796.         else if (!(s = fbm_instr((unsigned char*)s,
  797.           (unsigned char*)strend, pm->op_pmshort)))
  798.         goto nope;
  799.         else if (pm->op_pmflags & PMf_ALL)
  800.         goto yup;
  801.         if (s && rx->regback >= 0) {
  802.         ++BmUSEFUL(pm->op_pmshort);
  803.         s -= rx->regback;
  804.         if (s < t)
  805.             s = t;
  806.         }
  807.         else
  808.         s = t;
  809.     }
  810.     else if (!multiline) {
  811.         if (*SvPVX(pm->op_pmshort) != *s ||
  812.           bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
  813.         if (pm->op_pmflags & PMf_FOLD) {
  814.             if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
  815.             goto nope;
  816.         }
  817.         else
  818.             goto nope;
  819.         }
  820.     }
  821.     if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
  822.         SvREFCNT_dec(pm->op_pmshort);
  823.         pm->op_pmshort = Nullsv;    /* opt is being useless */
  824.     }
  825.     }
  826.     if (pregexec(rx, s, strend, truebase, minmatch,
  827.       SvSCREAM(TARG) ? TARG : Nullsv,
  828.       safebase)) {
  829.     curpm = pm;
  830.     if (pm->op_pmflags & PMf_ONCE)
  831.         pm->op_pmflags |= PMf_USED;
  832.     goto gotcha;
  833.     }
  834.     else
  835.     goto ret_no;
  836.     /*NOTREACHED*/
  837.  
  838.   gotcha:
  839.     if (gimme == G_ARRAY) {
  840.     I32 iters, i, len;
  841.  
  842.     iters = rx->nparens;
  843.     if (global && !iters)
  844.         i = 1;
  845.     else
  846.         i = 0;
  847.     EXTEND(SP, iters + i);
  848.     for (i = !i; i <= iters; i++) {
  849.         PUSHs(sv_newmortal());
  850.         /*SUPPRESS 560*/
  851.         if ((s = rx->startp[i]) && rx->endp[i] ) {
  852.         len = rx->endp[i] - s;
  853.         sv_setpvn(*SP, s, len);
  854.         }
  855.     }
  856.     if (global) {
  857.         truebase = rx->subbeg;
  858.         if (rx->startp[0] && rx->startp[0] == rx->endp[0])
  859.         ++rx->endp[0];
  860.         goto play_it_again;
  861.     }
  862.     LEAVE_SCOPE(oldsave);
  863.     RETURN;
  864.     }
  865.     else {
  866.     if (global) {
  867.         MAGIC* mg = 0;
  868.         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
  869.         mg = mg_find(TARG, 'g');
  870.         if (!mg) {
  871.         sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
  872.         mg = mg_find(TARG, 'g');
  873.         }
  874.         if (rx->startp[0]) {
  875.         mg->mg_len = rx->endp[0] - truebase;
  876.         if (rx->startp[0] == rx->endp[0])
  877.             mg->mg_flags |= MGf_MINMATCH;
  878.         else
  879.             mg->mg_flags &= ~MGf_MINMATCH;
  880.         }
  881.         else
  882.         mg->mg_len = -1;
  883.     }
  884.     LEAVE_SCOPE(oldsave);
  885.     RETPUSHYES;
  886.     }
  887.  
  888. yup:
  889.     ++BmUSEFUL(pm->op_pmshort);
  890.     curpm = pm;
  891.     if (pm->op_pmflags & PMf_ONCE)
  892.     pm->op_pmflags |= PMf_USED;
  893.     if (global) {
  894.     rx->subbeg = truebase;
  895.     rx->subend = strend;
  896.     rx->startp[0] = s;
  897.     rx->endp[0] = s + SvCUR(pm->op_pmshort);
  898.     goto gotcha;
  899.     }
  900.     if (sawampersand) {
  901.     char *tmps;
  902.  
  903.     if (rx->subbase)
  904.         Safefree(rx->subbase);
  905.     tmps = rx->subbase = savepvn(t, strend-t);
  906.     rx->subbeg = tmps;
  907.     rx->subend = tmps + (strend-t);
  908.     tmps = rx->startp[0] = tmps + (s - t);
  909.     rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
  910.     }
  911.     LEAVE_SCOPE(oldsave);
  912.     RETPUSHYES;
  913.  
  914. nope:
  915.     if (pm->op_pmshort)
  916.     ++BmUSEFUL(pm->op_pmshort);
  917.  
  918. ret_no:
  919.     if (global) {
  920.     if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
  921.         MAGIC* mg = mg_find(TARG, 'g');
  922.         if (mg)
  923.         mg->mg_len = -1;
  924.     }
  925.     }
  926.     LEAVE_SCOPE(oldsave);
  927.     if (gimme == G_ARRAY)
  928.     RETURN;
  929.     RETPUSHNO;
  930. }
  931.  
  932. OP *
  933. do_readline()
  934. {
  935.     dSP; dTARGETSTACKED;
  936.     register SV *sv;
  937.     STRLEN tmplen = 0;
  938.     STRLEN offset;
  939.     FILE *fp;
  940.     register IO *io = GvIO(last_in_gv);
  941.     register I32 type = op->op_type;
  942.  
  943.     fp = Nullfp;
  944.     if (io) {
  945.     fp = IoIFP(io);
  946.     if (!fp) {
  947.         if (IoFLAGS(io) & IOf_ARGV) {
  948.         if (IoFLAGS(io) & IOf_START) {
  949.             IoFLAGS(io) &= ~IOf_START;
  950.             IoLINES(io) = 0;
  951.             if (av_len(GvAVn(last_in_gv)) < 0) {
  952.             SV *tmpstr = newSVpv("-", 1); /* assume stdin */
  953.             av_push(GvAVn(last_in_gv), tmpstr);
  954.             }
  955.         }
  956.         fp = nextargv(last_in_gv);
  957.         if (!fp) { /* Note: fp != IoIFP(io) */
  958.             (void)do_close(last_in_gv, FALSE); /* now it does*/
  959.             IoFLAGS(io) |= IOf_START;
  960.         }
  961.         }
  962.         else if (type == OP_GLOB) {
  963.         SV *tmpcmd = NEWSV(55, 0);
  964.         SV *tmpglob = POPs;
  965.         ENTER;
  966.         SAVEFREESV(tmpcmd);
  967. #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
  968.            /* since spawning off a process is a real performance hit */
  969.         {
  970. #include <descrip.h>
  971. #include <lib$routines.h>
  972. #include <nam.h>
  973. #include <rmsdef.h>
  974.             char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
  975.             char vmsspec[NAM$C_MAXRSS+1];
  976.             char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
  977.             char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
  978.             $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
  979.             FILE *tmpfp;
  980.             STRLEN i;
  981.             struct dsc$descriptor_s wilddsc
  982.                = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
  983.             struct dsc$descriptor_vs rsdsc
  984.                = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt};
  985.             unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0;
  986.  
  987.             /* We could find out if there's an explicit dev/dir or version
  988.                by peeking into lib$find_file's internal context at
  989.                ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
  990.                but that's unsupported, so I don't want to do it now and
  991.                have it bite someone in the future. */
  992.             strcat(tmpfnam,tmpnam(NULL));
  993.             cp = SvPV(tmpglob,i);
  994.             for (; i; i--) {
  995.                if (cp[i] == ';') hasver = 1;
  996.                if (cp[i] == '.') {
  997.                    if (sts) hasver = 1;
  998.                    else sts = 1;
  999.                }
  1000.                if (cp[i] == '/') {
  1001.                   hasdir = isunix = 1;
  1002.                   break;
  1003.                }
  1004.                if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') {
  1005.                    hasdir = 1;
  1006.                    break;
  1007.                }
  1008.             }
  1009.             if ((tmpfp = fopen(tmpfnam,"w+","fop=dlt")) != NULL) {
  1010.                 ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
  1011.                 if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
  1012.                 while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
  1013.                                             &dfltdsc,NULL,NULL,NULL))&1)) {
  1014.                     end = rstr + (unsigned long int) *rslt;
  1015.                     if (!hasver) while (*end != ';') end--;
  1016.                     *(end++) = '\n';  *end = '\0';
  1017.                     for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
  1018.                     if (hasdir) {
  1019.                       if (isunix) trim_unixpath(rstr,SvPVX(tmpglob));
  1020.                       begin = rstr;
  1021.                     }
  1022.                     else {
  1023.                         begin = end;
  1024.                         while (*(--begin) != ']' && *begin != '>') ;
  1025.                         ++begin;
  1026.                     }
  1027.                     ok = (fputs(begin,tmpfp) != EOF);
  1028.                 }
  1029.                 if (cxt) (void)lib$find_file_end(&cxt);
  1030.                 if (ok && sts != RMS$_NMF &&
  1031.                     sts != RMS$_DNF && sts != RMS$_FNF) ok = 0;
  1032.                 if (!ok) {
  1033.                     if (!(sts & 1)) {
  1034.                       SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts);
  1035.                     }
  1036.                     fclose(tmpfp);
  1037.                     fp = NULL;
  1038.                 }
  1039.                 else {
  1040.                    rewind(tmpfp);
  1041.                    IoTYPE(io) = '<';
  1042.                    IoIFP(io) = fp = tmpfp;
  1043.                 }
  1044.             }
  1045.         }
  1046. #else /* !VMS */
  1047. #ifdef DOSISH
  1048.         sv_setpv(tmpcmd, "perlglob ");
  1049.         sv_catsv(tmpcmd, tmpglob);
  1050.         sv_catpv(tmpcmd, " |");
  1051. #else
  1052. #ifdef CSH
  1053.         sv_setpvn(tmpcmd, cshname, cshlen);
  1054.         sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
  1055.         sv_catsv(tmpcmd, tmpglob);
  1056.         sv_catpv(tmpcmd, "' 2>/dev/null |");
  1057. #else
  1058.         sv_setpv(tmpcmd, "echo ");
  1059.         sv_catsv(tmpcmd, tmpglob);
  1060. #if 'z' - 'a' == 25
  1061.         sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
  1062. #else
  1063.         sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
  1064. #endif
  1065. #endif /* !CSH */
  1066. #endif /* !MSDOS */
  1067.         (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
  1068.                   FALSE, 0, 0, Nullfp);
  1069.         fp = IoIFP(io);
  1070. #endif /* !VMS */
  1071.         LEAVE;
  1072.         }
  1073.     }
  1074.     else if (type == OP_GLOB)
  1075.         SP--;
  1076.     }
  1077.     if (!fp) {
  1078.     if (dowarn && io && !(IoFLAGS(io) & IOf_START))
  1079.         warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
  1080.     if (GIMME == G_SCALAR) {
  1081.         (void)SvOK_off(TARG);
  1082.         PUSHTARG;
  1083.     }
  1084.     RETURN;
  1085.     }
  1086.     if (GIMME == G_ARRAY) {
  1087.     sv = sv_2mortal(NEWSV(57, 80));
  1088.     offset = 0;
  1089.     }
  1090.     else {
  1091.     sv = TARG;
  1092.     (void)SvUPGRADE(sv, SVt_PV);
  1093.     tmplen = SvLEN(sv);    /* remember if already alloced */
  1094.     if (!tmplen)
  1095.         Sv_Grow(sv, 80);    /* try short-buffering it */
  1096.     if (type == OP_RCATLINE)
  1097.         offset = SvCUR(sv);
  1098.     else
  1099.         offset = 0;
  1100.     }
  1101.     for (;;) {
  1102.     if (!sv_gets(sv, fp, offset)) {
  1103.         clearerr(fp);
  1104.         if (IoFLAGS(io) & IOf_ARGV) {
  1105.         fp = nextargv(last_in_gv);
  1106.         if (fp)
  1107.             continue;
  1108.         (void)do_close(last_in_gv, FALSE);
  1109.         IoFLAGS(io) |= IOf_START;
  1110.         }
  1111.         else if (type == OP_GLOB) {
  1112.         (void)do_close(last_in_gv, FALSE);
  1113.         }
  1114.         if (GIMME == G_SCALAR) {
  1115.         (void)SvOK_off(TARG);
  1116.         PUSHTARG;
  1117.         }
  1118.         RETURN;
  1119.     }
  1120.     IoLINES(io)++;
  1121.     XPUSHs(sv);
  1122.     if (tainting) {
  1123.         tainted = TRUE;
  1124.         SvTAINT(sv); /* Anything from the outside world...*/
  1125.     }
  1126.     if (type == OP_GLOB) {
  1127.         char *tmps;
  1128.  
  1129.         if (SvCUR(sv) > 0 && SvCUR(rs) > 0) {
  1130.         tmps = SvEND(sv) - 1;
  1131.         if (*tmps == *SvPVX(rs)) {
  1132.             *tmps = '\0';
  1133.             SvCUR(sv)--;
  1134.         }
  1135.         }
  1136.         for (tmps = SvPVX(sv); *tmps; tmps++)
  1137.         if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
  1138.             strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
  1139.             break;
  1140.         if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
  1141.         (void)POPs;        /* Unmatched wildcard?  Chuck it... */
  1142.         continue;
  1143.         }
  1144.     }
  1145.     if (GIMME == G_ARRAY) {
  1146.         if (SvLEN(sv) - SvCUR(sv) > 20) {
  1147.         SvLEN_set(sv, SvCUR(sv)+1);
  1148.         Renew(SvPVX(sv), SvLEN(sv), char);
  1149.         }
  1150.         sv = sv_2mortal(NEWSV(58, 80));
  1151.         continue;
  1152.     }
  1153.     else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
  1154.         /* try to reclaim a bit of scalar space (only on 1st alloc) */
  1155.         if (SvCUR(sv) < 60)
  1156.         SvLEN_set(sv, 80);
  1157.         else
  1158.         SvLEN_set(sv, SvCUR(sv)+40);    /* allow some slop */
  1159.         Renew(SvPVX(sv), SvLEN(sv), char);
  1160.     }
  1161.     RETURN;
  1162.     }
  1163. }
  1164.  
  1165. PP(pp_enter)
  1166. {
  1167.     dSP;
  1168.     register CONTEXT *cx;
  1169.     I32 gimme;
  1170.  
  1171.     /*
  1172.      * We don't just use the GIMME macro here because it assumes there's
  1173.      * already a context, which ain't necessarily so at initial startup.
  1174.      */
  1175.  
  1176.     if (op->op_flags & OPf_KNOW)
  1177.     gimme = op->op_flags & OPf_LIST;
  1178.     else if (cxstack_ix >= 0)
  1179.     gimme = cxstack[cxstack_ix].blk_gimme;
  1180.     else
  1181.     gimme = G_SCALAR;
  1182.  
  1183.     ENTER;
  1184.  
  1185.     SAVETMPS;
  1186.     PUSHBLOCK(cx, CXt_BLOCK, sp);
  1187.  
  1188.     RETURN;
  1189. }
  1190.  
  1191. PP(pp_helem)
  1192. {
  1193.     dSP;
  1194.     SV** svp;
  1195.     SV *keysv = POPs;
  1196.     STRLEN keylen;
  1197.     char *key = SvPV(keysv, keylen);
  1198.     HV *hv = (HV*)POPs;
  1199.     I32 lval = op->op_flags & OPf_MOD;
  1200.  
  1201.     if (SvTYPE(hv) != SVt_PVHV)
  1202.     RETPUSHUNDEF;
  1203.     svp = hv_fetch(hv, key, keylen, lval);
  1204.     if (lval) {
  1205.     if (!svp || *svp == &sv_undef)
  1206.         DIE(no_helem, key);
  1207.     if (op->op_private & OPpLVAL_INTRO)
  1208.         save_svref(svp);
  1209.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
  1210.         provide_ref(op, *svp);
  1211.     }
  1212.     PUSHs(svp ? *svp : &sv_undef);
  1213.     RETURN;
  1214. }
  1215.  
  1216. PP(pp_leave)
  1217. {
  1218.     dSP;
  1219.     register CONTEXT *cx;
  1220.     register SV **mark;
  1221.     SV **newsp;
  1222.     PMOP *newpm;
  1223.     I32 gimme;
  1224.  
  1225.     if (op->op_flags & OPf_SPECIAL) {
  1226.     cx = &cxstack[cxstack_ix];
  1227.     cx->blk_oldpm = curpm;    /* fake block should preserve $1 et al */
  1228.     }
  1229.  
  1230.     POPBLOCK(cx,newpm);
  1231.  
  1232.     if (op->op_flags & OPf_KNOW)
  1233.     gimme = op->op_flags & OPf_LIST;
  1234.     else if (cxstack_ix >= 0)
  1235.     gimme = cxstack[cxstack_ix].blk_gimme;
  1236.     else
  1237.     gimme = G_SCALAR;
  1238.  
  1239.     if (gimme == G_SCALAR) {
  1240.     if (op->op_private & OPpLEAVE_VOID)
  1241.         SP = newsp;
  1242.     else {
  1243.         MARK = newsp + 1;
  1244.         if (MARK <= SP)
  1245.         if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
  1246.             *MARK = TOPs;
  1247.         else
  1248.             *MARK = sv_mortalcopy(TOPs);
  1249.         else {
  1250.         MEXTEND(mark,0);
  1251.         *MARK = &sv_undef;
  1252.         }
  1253.         SP = MARK;
  1254.     }
  1255.     }
  1256.     else {
  1257.     for (mark = newsp + 1; mark <= SP; mark++)
  1258.         if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
  1259.         *mark = sv_mortalcopy(*mark);
  1260.         /* in case LEAVE wipes old return values */
  1261.     }
  1262.     curpm = newpm;    /* Don't pop $1 et al till now */
  1263.  
  1264.     LEAVE;
  1265.  
  1266.     RETURN;
  1267. }
  1268.  
  1269. PP(pp_iter)
  1270. {
  1271.     dSP;
  1272.     register CONTEXT *cx;
  1273.     SV *sv;
  1274.     AV* av;
  1275.  
  1276.     EXTEND(sp, 1);
  1277.     cx = &cxstack[cxstack_ix];
  1278.     if (cx->cx_type != CXt_LOOP)
  1279.     DIE("panic: pp_iter");
  1280.     av = cx->blk_loop.iterary;
  1281.     if (av == stack && cx->blk_loop.iterix >= cx->blk_oldsp)
  1282.     RETPUSHNO;
  1283.  
  1284.     if (cx->blk_loop.iterix >= AvFILL(av))
  1285.     RETPUSHNO;
  1286.  
  1287.     if (sv = AvARRAY(av)[++cx->blk_loop.iterix]) {
  1288.     SvTEMP_off(sv);
  1289.     *cx->blk_loop.itervar = sv;
  1290.     }
  1291.     else
  1292.     *cx->blk_loop.itervar = &sv_undef;
  1293.  
  1294.     RETPUSHYES;
  1295. }
  1296.  
  1297. PP(pp_subst)
  1298. {
  1299.     dSP; dTARG;
  1300.     register PMOP *pm = cPMOP;
  1301.     PMOP *rpm = pm;
  1302.     register SV *dstr;
  1303.     register char *s;
  1304.     char *strend;
  1305.     register char *m;
  1306.     char *c;
  1307.     register char *d;
  1308.     STRLEN clen;
  1309.     I32 iters = 0;
  1310.     I32 maxiters;
  1311.     register I32 i;
  1312.     bool once;
  1313.     char *orig;
  1314.     I32 safebase;
  1315.     register REGEXP *rx = pm->op_pmregexp;
  1316.     STRLEN len;
  1317.     int force_on_match = 0;
  1318.     I32 oldsave = savestack_ix;
  1319.  
  1320.     if (pm->op_pmflags & PMf_CONST)    /* known replacement string? */
  1321.     dstr = POPs;
  1322.     if (op->op_flags & OPf_STACKED)
  1323.     TARG = POPs;
  1324.     else {
  1325.     TARG = GvSV(defgv);
  1326.     EXTEND(SP,1);
  1327.     }
  1328.     s = SvPV(TARG, len);
  1329.     if (!SvPOKp(TARG) || SvREADONLY(TARG) || (SvTYPE(TARG) == SVt_PVGV))
  1330.     force_on_match = 1;
  1331.  
  1332.   force_it:
  1333.     if (!pm || !s)
  1334.     DIE("panic: do_subst");
  1335.  
  1336.     strend = s + len;
  1337.     maxiters = (strend - s) + 10;
  1338.  
  1339.     if (!rx->prelen && curpm) {
  1340.     pm = curpm;
  1341.     rx = pm->op_pmregexp;
  1342.     }
  1343.     safebase = ((!rx || !rx->nparens) && !sawampersand);
  1344.     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  1345.     SAVEINT(multiline);
  1346.     multiline = pm->op_pmflags & PMf_MULTILINE;
  1347.     }
  1348.     orig = m = s;
  1349.     if (pm->op_pmshort) {
  1350.     if (pm->op_pmflags & PMf_SCANFIRST) {
  1351.         if (SvSCREAM(TARG)) {
  1352.         if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
  1353.             goto nope;
  1354.         else if (!(s = screaminstr(TARG, pm->op_pmshort)))
  1355.             goto nope;
  1356.         }
  1357.         else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
  1358.           pm->op_pmshort)))
  1359.         goto nope;
  1360.         if (s && rx->regback >= 0) {
  1361.         ++BmUSEFUL(pm->op_pmshort);
  1362.         s -= rx->regback;
  1363.         if (s < m)
  1364.             s = m;
  1365.         }
  1366.         else
  1367.         s = m;
  1368.     }
  1369.     else if (!multiline) {
  1370.         if (*SvPVX(pm->op_pmshort) != *s ||
  1371.           bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
  1372.         if (pm->op_pmflags & PMf_FOLD) {
  1373.             if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
  1374.             goto nope;
  1375.         }
  1376.         else
  1377.             goto nope;
  1378.         }
  1379.     }
  1380.     if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
  1381.         SvREFCNT_dec(pm->op_pmshort);
  1382.         pm->op_pmshort = Nullsv;    /* opt is being useless */
  1383.     }
  1384.     }
  1385.     once = !(rpm->op_pmflags & PMf_GLOBAL);
  1386.     if (rpm->op_pmflags & PMf_CONST) {    /* known replacement string? */
  1387.     c = SvPV(dstr, clen);
  1388.     if (clen <= rx->minlen) {
  1389.                     /* can do inplace substitution */
  1390.         if (pregexec(rx, s, strend, orig, 0,
  1391.           SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
  1392.         if (force_on_match) {
  1393.             force_on_match = 0;
  1394.             s = SvPV_force(TARG, len);
  1395.             goto force_it;
  1396.         }
  1397.         if (rx->subbase)     /* oops, no we can't */
  1398.             goto long_way;
  1399.         d = s;
  1400.         curpm = pm;
  1401.         SvSCREAM_off(TARG);    /* disable possible screamer */
  1402.         if (once) {
  1403.             m = rx->startp[0];
  1404.             d = rx->endp[0];
  1405.             s = orig;
  1406.             if (m - s > strend - d) {    /* faster to shorten from end */
  1407.             if (clen) {
  1408.                 Copy(c, m, clen, char);
  1409.                 m += clen;
  1410.             }
  1411.             i = strend - d;
  1412.             if (i > 0) {
  1413.                 Move(d, m, i, char);
  1414.                 m += i;
  1415.             }
  1416.             *m = '\0';
  1417.             SvCUR_set(TARG, m - s);
  1418.             (void)SvPOK_only(TARG);
  1419.             SvSETMAGIC(TARG);
  1420.             PUSHs(&sv_yes);
  1421.             LEAVE_SCOPE(oldsave);
  1422.             RETURN;
  1423.             }
  1424.             /*SUPPRESS 560*/
  1425.             else if (i = m - s) {    /* faster from front */
  1426.             d -= clen;
  1427.             m = d;
  1428.             sv_chop(TARG, d-i);
  1429.             s += i;
  1430.             while (i--)
  1431.                 *--d = *--s;
  1432.             if (clen)
  1433.                 Copy(c, m, clen, char);
  1434.             (void)SvPOK_only(TARG);
  1435.             SvSETMAGIC(TARG);
  1436.             PUSHs(&sv_yes);
  1437.             LEAVE_SCOPE(oldsave);
  1438.             RETURN;
  1439.             }
  1440.             else if (clen) {
  1441.             d -= clen;
  1442.             sv_chop(TARG, d);
  1443.             Copy(c, d, clen, char);
  1444.             (void)SvPOK_only(TARG);
  1445.             SvSETMAGIC(TARG);
  1446.             PUSHs(&sv_yes);
  1447.             LEAVE_SCOPE(oldsave);
  1448.             RETURN;
  1449.             }
  1450.             else {
  1451.             sv_chop(TARG, d);
  1452.             (void)SvPOK_only(TARG);
  1453.             SvSETMAGIC(TARG);
  1454.             PUSHs(&sv_yes);
  1455.             LEAVE_SCOPE(oldsave);
  1456.             RETURN;
  1457.             }
  1458.             /* NOTREACHED */
  1459.         }
  1460.         do {
  1461.             if (iters++ > maxiters)
  1462.             DIE("Substitution loop");
  1463.             m = rx->startp[0];
  1464.             /*SUPPRESS 560*/
  1465.             if (i = m - s) {
  1466.             if (s != d)
  1467.                 Move(s, d, i, char);
  1468.             d += i;
  1469.             }
  1470.             if (clen) {
  1471.             Copy(c, d, clen, char);
  1472.             d += clen;
  1473.             }
  1474.             s = rx->endp[0];
  1475.         } while (pregexec(rx, s, strend, orig, s == m,
  1476.             Nullsv, TRUE));    /* (don't match same null twice) */
  1477.         if (s != d) {
  1478.             i = strend - s;
  1479.             SvCUR_set(TARG, d - SvPVX(TARG) + i);
  1480.             Move(s, d, i+1, char);        /* include the Null */
  1481.         }
  1482.         (void)SvPOK_only(TARG);
  1483.         SvSETMAGIC(TARG);
  1484.         PUSHs(sv_2mortal(newSViv((I32)iters)));
  1485.         LEAVE_SCOPE(oldsave);
  1486.         RETURN;
  1487.         }
  1488.         PUSHs(&sv_no);
  1489.         LEAVE_SCOPE(oldsave);
  1490.         RETURN;
  1491.     }
  1492.     }
  1493.     else
  1494.     c = Nullch;
  1495.     if (pregexec(rx, s, strend, orig, 0,
  1496.       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
  1497.     long_way:
  1498.     if (force_on_match) {
  1499.         force_on_match = 0;
  1500.         s = SvPV_force(TARG, len);
  1501.         goto force_it;
  1502.     }
  1503.     dstr = NEWSV(25, sv_len(TARG));
  1504.     sv_setpvn(dstr, m, s-m);
  1505.     curpm = pm;
  1506.     if (!c) {
  1507.         register CONTEXT *cx;
  1508.         PUSHSUBST(cx);
  1509.         RETURNOP(cPMOP->op_pmreplroot);
  1510.     }
  1511.     do {
  1512.         if (iters++ > maxiters)
  1513.         DIE("Substitution loop");
  1514.         if (rx->subbase && rx->subbase != orig) {
  1515.         m = s;
  1516.         s = orig;
  1517.         orig = rx->subbase;
  1518.         s = orig + (m - s);
  1519.         strend = s + (strend - m);
  1520.         }
  1521.         m = rx->startp[0];
  1522.         sv_catpvn(dstr, s, m-s);
  1523.         s = rx->endp[0];
  1524.         if (clen)
  1525.         sv_catpvn(dstr, c, clen);
  1526.         if (once)
  1527.         break;
  1528.     } while (pregexec(rx, s, strend, orig, s == m, Nullsv,
  1529.         safebase));
  1530.     sv_catpvn(dstr, s, strend - s);
  1531.  
  1532.     (void)SvOOK_off(TARG);
  1533.     Safefree(SvPVX(TARG));
  1534.     SvPVX(TARG) = SvPVX(dstr);
  1535.     SvCUR_set(TARG, SvCUR(dstr));
  1536.     SvLEN_set(TARG, SvLEN(dstr));
  1537.     SvPVX(dstr) = 0;
  1538.     sv_free(dstr);
  1539.  
  1540.     (void)SvPOK_only(TARG);
  1541.     SvSETMAGIC(TARG);
  1542.     PUSHs(sv_2mortal(newSViv((I32)iters)));
  1543.     LEAVE_SCOPE(oldsave);
  1544.     RETURN;
  1545.     }
  1546.     PUSHs(&sv_no);
  1547.     LEAVE_SCOPE(oldsave);
  1548.     RETURN;
  1549.  
  1550. nope:
  1551.     ++BmUSEFUL(pm->op_pmshort);
  1552.     PUSHs(&sv_no);
  1553.     LEAVE_SCOPE(oldsave);
  1554.     RETURN;
  1555. }
  1556.  
  1557. PP(pp_grepwhile)
  1558. {
  1559.     dSP;
  1560.  
  1561.     if (SvTRUEx(POPs))
  1562.     stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
  1563.     ++*markstack_ptr;
  1564.     LEAVE;                    /* exit inner scope */
  1565.  
  1566.     /* All done yet? */
  1567.     if (stack_base + *markstack_ptr > sp) {
  1568.     I32 items;
  1569.  
  1570.     LEAVE;                    /* exit outer scope */
  1571.     (void)POPMARK;                /* pop src */
  1572.     items = --*markstack_ptr - markstack_ptr[-1];
  1573.     (void)POPMARK;                /* pop dst */
  1574.     SP = stack_base + POPMARK;        /* pop original mark */
  1575.     if (GIMME != G_ARRAY) {
  1576.         dTARGET;
  1577.         XPUSHi(items);
  1578.         RETURN;
  1579.     }
  1580.     SP += items;
  1581.     RETURN;
  1582.     }
  1583.     else {
  1584.     SV *src;
  1585.  
  1586.     ENTER;                    /* enter inner scope */
  1587.     SAVESPTR(curpm);
  1588.  
  1589.     src = stack_base[*markstack_ptr];
  1590.     SvTEMP_off(src);
  1591.     GvSV(defgv) = src;
  1592.  
  1593.     RETURNOP(cLOGOP->op_other);
  1594.     }
  1595. }
  1596.  
  1597. PP(pp_leavesub)
  1598. {
  1599.     dSP;
  1600.     SV **mark;
  1601.     SV **newsp;
  1602.     PMOP *newpm;
  1603.     I32 gimme;
  1604.     register CONTEXT *cx;
  1605.  
  1606.     POPBLOCK(cx,newpm);
  1607.     POPSUB(cx);
  1608.  
  1609.     if (gimme == G_SCALAR) {
  1610.     MARK = newsp + 1;
  1611.     if (MARK <= SP)
  1612.         if (SvFLAGS(TOPs) & SVs_TEMP)
  1613.         *MARK = TOPs;
  1614.         else
  1615.         *MARK = sv_mortalcopy(TOPs);
  1616.     else {
  1617.         MEXTEND(mark,0);
  1618.         *MARK = &sv_undef;
  1619.     }
  1620.     SP = MARK;
  1621.     }
  1622.     else {
  1623.     for (mark = newsp + 1; mark <= SP; mark++)
  1624.         if (!(SvFLAGS(*mark) & SVs_TEMP))
  1625.         *mark = sv_mortalcopy(*mark);
  1626.         /* in case LEAVE wipes old return values */
  1627.     }
  1628.  
  1629.     if (cx->blk_sub.hasargs) {        /* You don't exist; go away. */
  1630.     AV* av = cx->blk_sub.argarray;
  1631.  
  1632.     av_clear(av);
  1633.     AvREAL_off(av);
  1634.     }
  1635.     curpm = newpm;    /* Don't pop $1 et al till now */
  1636.  
  1637.     LEAVE;
  1638.     PUTBACK;
  1639.     return pop_return();
  1640. }
  1641.  
  1642. PP(pp_entersub)
  1643. {
  1644.     dSP; dPOPss;
  1645.     GV *gv;
  1646.     HV *stash;
  1647.     register CV *cv;
  1648.     register CONTEXT *cx;
  1649.     I32 gimme;
  1650.  
  1651.     if (!sv)
  1652.     DIE("Not a CODE reference");
  1653.     switch (SvTYPE(sv)) {
  1654.     default:
  1655.     if (!SvROK(sv)) {
  1656.         char *sym;
  1657.  
  1658.         if (sv == &sv_yes)        /* unfound import, ignore */
  1659.         RETURN;
  1660.         if (!SvOK(sv))
  1661.         DIE(no_usym, "a subroutine");
  1662.         sym = SvPV(sv,na);
  1663.         if (op->op_private & HINT_STRICT_REFS)
  1664.         DIE(no_symref, sym, "a subroutine");
  1665.         cv = perl_get_cv(sym, TRUE);
  1666.         break;
  1667.     }
  1668.     cv = (CV*)SvRV(sv);
  1669.     if (SvTYPE(cv) == SVt_PVCV)
  1670.         break;
  1671.     /* FALL THROUGH */
  1672.     case SVt_PVHV:
  1673.     case SVt_PVAV:
  1674.     DIE("Not a CODE reference");
  1675.     case SVt_PVCV:
  1676.     cv = (CV*)sv;
  1677.     break;
  1678.     case SVt_PVGV:
  1679.     if (!(cv = GvCV((GV*)sv)))
  1680.         cv = sv_2cv(sv, &stash, &gv, TRUE);
  1681.     break;
  1682.     }
  1683.  
  1684.     ENTER;
  1685.     SAVETMPS;
  1686.  
  1687.   retry:
  1688.     if (!cv)
  1689.     DIE("Not a CODE reference");
  1690.  
  1691.     if (!CvROOT(cv) && !CvXSUB(cv)) {
  1692.     if (gv = CvGV(cv)) {
  1693.         SV *tmpstr;
  1694.         GV *ngv;
  1695.         if (SvFAKE(cv) && GvCV(gv) != cv) {    /* autoloaded stub? */
  1696.         cv = GvCV(gv);
  1697.         if (SvTYPE(sv) == SVt_PVGV) {
  1698.             SvREFCNT_dec(GvCV((GV*)sv));
  1699.             GvCV((GV*)sv) = (CV*)SvREFCNT_inc((SV*)cv);
  1700.         }
  1701.         goto retry;
  1702.         }
  1703.         tmpstr = sv_newmortal();
  1704.         gv_efullname(tmpstr, gv);
  1705.         ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
  1706.         if (ngv && ngv != gv && (cv = GvCV(ngv))) {    /* One more chance... */
  1707.         gv = ngv;
  1708.         sv_setsv(GvSV(CvGV(cv)), tmpstr);    /* Set CV's $AUTOLOAD */
  1709.         if (tainting)
  1710.             sv_unmagic(GvSV(CvGV(cv)), 't');
  1711.         goto retry;
  1712.         }
  1713.         else
  1714.         DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
  1715.     }
  1716.     DIE("Undefined subroutine called");
  1717.     }
  1718.  
  1719.     gimme = GIMME;
  1720.     if ((op->op_private & OPpENTERSUB_DB) && !CvXSUB(cv)) {
  1721.     sv = GvSV(DBsub);
  1722.     save_item(sv);
  1723.     if (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) {
  1724.         /* GV is potentially non-unique */
  1725.         sv_setsv(sv, newRV((SV*)cv));
  1726.     }
  1727.     else {
  1728.         gv = CvGV(cv);
  1729.         gv_efullname(sv,gv);
  1730.     }
  1731.     cv = GvCV(DBsub);
  1732.     if (!cv)
  1733.         DIE("No DBsub routine");
  1734.     }
  1735.  
  1736.     if (CvXSUB(cv)) {
  1737.     if (CvOLDSTYLE(cv)) {
  1738.         I32 (*fp3)_((int,int,int));
  1739.         dMARK;
  1740.         register I32 items = SP - MARK;
  1741.         while (sp > mark) {
  1742.         sp[1] = sp[0];
  1743.         sp--;
  1744.         }
  1745.         stack_sp = mark + 1;
  1746.         fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
  1747.         items = (*fp3)(CvXSUBANY(cv).any_i32, 
  1748.                MARK - stack_base + 1,
  1749.                items);
  1750.         stack_sp = stack_base + items;
  1751.     }
  1752.     else {
  1753.         I32 markix = TOPMARK;
  1754.  
  1755.         PUTBACK;
  1756.         (void)(*CvXSUB(cv))(cv);
  1757.  
  1758.         /* Enforce some sanity in scalar context. */
  1759.         if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
  1760.         if (markix > stack_sp - stack_base)
  1761.             *(stack_base + markix) = &sv_undef;
  1762.         else
  1763.             *(stack_base + markix) = *stack_sp;
  1764.         stack_sp = stack_base + markix;
  1765.         }
  1766.     }
  1767.     LEAVE;
  1768.     return NORMAL;
  1769.     }
  1770.     else {
  1771.     dMARK;
  1772.     register I32 items = SP - MARK;
  1773.     I32 hasargs = (op->op_flags & OPf_STACKED) != 0;
  1774.     AV* padlist = CvPADLIST(cv);
  1775.     SV** svp = AvARRAY(padlist);
  1776.     push_return(op->op_next);
  1777.     PUSHBLOCK(cx, CXt_SUB, MARK);
  1778.     PUSHSUB(cx);
  1779.     CvDEPTH(cv)++;
  1780.     if (CvDEPTH(cv) < 2)
  1781.         (void)SvREFCNT_inc(cv);
  1782.     else {    /* save temporaries on recursion? */
  1783.         if (CvDEPTH(cv) == 100 && dowarn)
  1784.         warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
  1785.         if (CvDEPTH(cv) > AvFILL(padlist)) {
  1786.         AV *av;
  1787.         AV *newpad = newAV();
  1788.         SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
  1789.         I32 ix = AvFILL((AV*)svp[1]);
  1790.         svp = AvARRAY(svp[0]);
  1791.         for ( ;ix > 0; ix--) {
  1792.             if (svp[ix] != &sv_undef) {
  1793.             char *name = SvPVX(svp[ix]);
  1794.             if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* outer lexical? */
  1795.                 av_store(newpad, ix,
  1796.                 SvREFCNT_inc(oldpad[ix]) );
  1797.             }
  1798.             else {                /* our own lexical */
  1799.                 if (*name == '@')
  1800.                 av_store(newpad, ix, sv = (SV*)newAV());
  1801.                 else if (*name == '%')
  1802.                 av_store(newpad, ix, sv = (SV*)newHV());
  1803.                 else
  1804.                 av_store(newpad, ix, sv = NEWSV(0,0));
  1805.                 SvPADMY_on(sv);
  1806.             }
  1807.             }
  1808.             else {
  1809.             av_store(newpad, ix, sv = NEWSV(0,0));
  1810.             SvPADTMP_on(sv);
  1811.             }
  1812.         }
  1813.         av = newAV();        /* will be @_ */
  1814.         av_extend(av, 0);
  1815.         av_store(newpad, 0, (SV*)av);
  1816.         AvFLAGS(av) = AVf_REIFY;
  1817.         av_store(padlist, CvDEPTH(cv), (SV*)newpad);
  1818.         AvFILL(padlist) = CvDEPTH(cv);
  1819.         svp = AvARRAY(padlist);
  1820.         }
  1821.     }
  1822.     SAVESPTR(curpad);
  1823.     curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
  1824.     if (hasargs) {
  1825.         AV* av = (AV*)curpad[0];
  1826.         SV** ary;
  1827.  
  1828.         if (AvREAL(av)) {
  1829.         av_clear(av);
  1830.         AvREAL_off(av);
  1831.         }
  1832.         cx->blk_sub.savearray = GvAV(defgv);
  1833.         cx->blk_sub.argarray = av;
  1834.         GvAV(defgv) = cx->blk_sub.argarray;
  1835.         ++MARK;
  1836.  
  1837.         if (items > AvMAX(av) + 1) {
  1838.         ary = AvALLOC(av);
  1839.         if (AvARRAY(av) != ary) {
  1840.             AvMAX(av) += AvARRAY(av) - AvALLOC(av);
  1841.             SvPVX(av) = (char*)ary;
  1842.         }
  1843.         if (items > AvMAX(av) + 1) {
  1844.             AvMAX(av) = items - 1;
  1845.             Renew(ary,items,SV*);
  1846.             AvALLOC(av) = ary;
  1847.             SvPVX(av) = (char*)ary;
  1848.         }
  1849.         }
  1850.         Copy(MARK,AvARRAY(av),items,SV*);
  1851.         AvFILL(av) = items - 1;
  1852.         
  1853.         while (items--) {
  1854.         if (*MARK)
  1855.             SvTEMP_off(*MARK);
  1856.         MARK++;
  1857.         }
  1858.     }
  1859.     RETURNOP(CvSTART(cv));
  1860.     }
  1861. }
  1862.  
  1863. PP(pp_aelem)
  1864. {
  1865.     dSP;
  1866.     SV** svp;
  1867.     I32 elem = POPi;
  1868.     AV *av = (AV*)POPs;
  1869.     I32 lval = op->op_flags & OPf_MOD;
  1870.  
  1871.     if (elem > 0)
  1872.     elem -= curcop->cop_arybase;
  1873.     if (SvTYPE(av) != SVt_PVAV)
  1874.     RETPUSHUNDEF;
  1875.     svp = av_fetch(av, elem, lval);
  1876.     if (lval) {
  1877.     if (!svp || *svp == &sv_undef)
  1878.         DIE(no_aelem, elem);
  1879.     if (op->op_private & OPpLVAL_INTRO)
  1880.         save_svref(svp);
  1881.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
  1882.         provide_ref(op, *svp);
  1883.     }
  1884.     PUSHs(svp ? *svp : &sv_undef);
  1885.     RETURN;
  1886. }
  1887.  
  1888. void
  1889. provide_ref(op, sv)
  1890. OP* op;
  1891. SV* sv;
  1892. {
  1893.     if (SvGMAGICAL(sv))
  1894.     mg_get(sv);
  1895.     if (!SvOK(sv)) {
  1896.     if (SvREADONLY(sv))
  1897.         croak(no_modify);
  1898.     (void)SvUPGRADE(sv, SVt_RV);
  1899.     SvRV(sv) = (op->op_private & OPpDEREF_HV ?
  1900.             (SV*)newHV() : (SV*)newAV());
  1901.     SvROK_on(sv);
  1902.     SvSETMAGIC(sv);
  1903.     }
  1904. }
  1905.  
  1906. PP(pp_method)
  1907. {
  1908.     dSP;
  1909.     SV* sv;
  1910.     SV* ob;
  1911.     GV* gv;
  1912.     SV* nm;
  1913.  
  1914.     nm = TOPs;
  1915.     sv = *(stack_base + TOPMARK + 1);
  1916.     
  1917.     gv = 0;
  1918.     if (SvGMAGICAL(sv))
  1919.         mg_get(sv);
  1920.     if (SvROK(sv))
  1921.     ob = (SV*)SvRV(sv);
  1922.     else {
  1923.     GV* iogv;
  1924.     char* packname = 0;
  1925.  
  1926.     if (!SvOK(sv) ||
  1927.         !(packname = SvPV(sv, na)) ||
  1928.         !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
  1929.         !(ob=(SV*)GvIO(iogv)))
  1930.     {
  1931.         char *name = SvPV(nm, na);
  1932.         HV *stash;
  1933.         if (!packname || !isALPHA(*packname))
  1934. DIE("Can't call method \"%s\" without a package or object reference", name);
  1935.         if (!(stash = gv_stashpv(packname, FALSE))) {
  1936.         if (gv_stashpv("UNIVERSAL", FALSE))
  1937.             stash = gv_stashpv(packname, TRUE);
  1938.         else
  1939.             DIE("Can't call method \"%s\" in empty package \"%s\"",
  1940.             name, packname);
  1941.         }
  1942.         gv = gv_fetchmethod(stash,name);
  1943.         if (!gv)
  1944.         DIE("Can't locate object method \"%s\" via package \"%s\"",
  1945.             name, packname);
  1946.         SETs(gv);
  1947.         RETURN;
  1948.     }
  1949.     *(stack_base + TOPMARK + 1) = sv_2mortal(newRV(iogv));
  1950.     }
  1951.  
  1952.     if (!ob || !SvOBJECT(ob)) {
  1953.     char *name = SvPV(nm, na);
  1954.     DIE("Can't call method \"%s\" on unblessed reference", name);
  1955.     }
  1956.  
  1957.     if (!gv) {        /* nothing cached */
  1958.     char *name = SvPV(nm, na);
  1959.     gv = gv_fetchmethod(SvSTASH(ob),name);
  1960.     if (!gv)
  1961.         DIE("Can't locate object method \"%s\" via package \"%s\"",
  1962.         name, HvNAME(SvSTASH(ob)));
  1963.     }
  1964.  
  1965.     SETs(gv);
  1966.     RETURN;
  1967. }
  1968.  
  1969.